home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ape-ad1a / cdxvbsur.cls < prev    next >
Text File  |  1999-08-08  |  8KB  |  239 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CDXVBSurface"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. ' WORKING! AT THE MOMENT...
  15.  
  16. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
  17. Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
  18. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  19. Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  20. Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  21. Private Declare Function GetDC Lib "User32" (ByVal hWnd As Long) As Long
  22. Private Declare Function LoadImage Lib "User32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
  23. Private Declare Function StretchBlt Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
  24.  
  25. Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal i As Long, ByVal u As Long, ByVal s As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
  26. Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
  27. Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
  28. Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
  29.  
  30. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
  31.  
  32. Private Const LR_LOADFROMFILE = &H10
  33. Private Const LR_CREATEDIBSECTION = &H2000
  34. Private Const SRCCOPY = &HCC0020
  35.  
  36. Private Const TRANSPARENT = 1
  37. Private Const ANSI_CHARSET = 0
  38. Private Const OUT_DEFAULT_PRECIS = 0
  39. Private Const CLIP_DEFAULT_PRECIS = 0
  40. Private Const VARIABLE_PITCH = 2
  41.  
  42. Private Const FW_NORMAL = 400
  43. Private Const FW_REGULAR = FW_NORMAL
  44. Private Const FW_SEMIBOLD = 600
  45. Private Const FW_THIN = 100
  46.  
  47.  
  48. Private Type BITMAP
  49.         bmType          As Long
  50.         bmWidth         As Long
  51.         bmHeight        As Long
  52.         bmWidthBytes    As Long
  53.         bmPlanes        As Integer
  54.         bmBitsPixel     As Integer
  55.         bmBits          As Long
  56. End Type
  57.  
  58.  
  59. Public m_lpDDS As IDirectDrawSurface2
  60. Private m_ddsd As DDSURFACEDESC
  61.  
  62. Public m_PixelWidth As Integer
  63. Public m_PixelHeight As Integer
  64. Public Filename As String
  65.  
  66. Public m_HDC As Long
  67. Public m_Font As Long
  68. Public m_ColorKey As Integer
  69.  
  70. Private m_SrcRect As RECT
  71. Private m_DstRect As RECT
  72.  
  73.  
  74. Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
  75.  
  76. Private Type SAFEARRAYBOUND
  77.     cElements As Long
  78.     lLbound As Long
  79. End Type
  80.  
  81. Private Type SAFEARRAY1D
  82.     cDims As Integer
  83.     fFeatures As Integer
  84.     cbElements As Long
  85.     cLocks As Long
  86.     pvData As Long
  87.     Bounds(0 To 0) As SAFEARRAYBOUND
  88. End Type
  89.  
  90. Private Type SAFEARRAY2D
  91.     cDims As Integer
  92.     fFeatures As Integer
  93.     cbElements As Long
  94.     cLocks As Long
  95.     pvData As Long
  96.     Bounds(0 To 1) As SAFEARRAYBOUND
  97. End Type
  98.  
  99. Private video_buffer() As Byte
  100. Private sa As SAFEARRAY2D
  101.  
  102. Private Function LoadBitmap(DXObject As IDirectDraw2, ByVal BMPFile As String) As IDirectDrawSurface2
  103.     Dim hBitmap As Long                 ' Handle on bitmap
  104.     Dim dBitmap As BITMAP               ' Handle on bitmap descriptor
  105.     Dim TempDXD As DDSURFACEDESC        ' Surface description
  106.     Dim TempDXS As IDirectDrawSurface3   ' Created surface
  107.     Dim dcBitmap As Long                ' Handle on image
  108.     Dim dcDXS As Long                   ' Handle on surface context
  109.     Dim ddck As DDCOLORKEY
  110.     
  111.     ddck.dwColorSpaceLowValue = 0
  112.     ddck.dwColorSpaceHighValue = 0
  113.     
  114.     ' Load bitmap
  115.     hBitmap = LoadImage(ByVal 0&, BMPFile, 0, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
  116.     
  117.     ' Get bitmap descriptor
  118.     GetObject hBitmap, Len(dBitmap), dBitmap
  119.     
  120.     ' Fill DX surface description
  121.     With TempDXD
  122.         .dwSize = Len(TempDXD)
  123.         .dwflags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
  124.         .DDSCAPS.dwCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
  125.         .dwWidth = dBitmap.bmWidth
  126.         .dwHeight = dBitmap.bmHeight
  127.     End With
  128.     
  129.       m_SrcRect.top = 0
  130.       m_SrcRect.left = 0
  131.       m_SrcRect.bottom = dBitmap.bmHeight
  132.       m_SrcRect.right = dBitmap.bmWidth
  133.       
  134.       m_PixelWidth = dBitmap.bmWidth
  135.       m_PixelHeight = dBitmap.bmHeight
  136.     
  137.     ' Create DX surface
  138.     DXObject.CreateSurface TempDXD, TempDXS, Nothing
  139.     
  140.     ' Create API memory DC
  141.     dcBitmap = CreateCompatibleDC(ByVal 0&)
  142.     ' Select the bitmap into API memory DC
  143.     SelectObject dcBitmap, hBitmap
  144.     
  145.     ' Restore DX surface
  146.     TempDXS.Restore
  147.     ' Get DX surface API DC
  148.     TempDXS.GetDC dcDXS
  149.     ' Blit BMP from API DC into DX DC using standard API BitBlt
  150.     StretchBlt dcDXS, 0, 0, TempDXD.dwWidth, TempDXD.dwHeight, dcBitmap, 0, 0, dBitmap.bmWidth, dBitmap.bmHeight, SRCCOPY
  151.  
  152.     ' Cleanup
  153.     TempDXS.ReleaseDC dcDXS
  154.     DeleteDC dcBitmap
  155.     DeleteObject hBitmap
  156.     
  157.     TempDXS.SetColorKey DDCKEY_SRCBLT, ddck
  158.     ' Return created DX surface
  159.     Set LoadBitmap = TempDXS
  160. End Function
  161.  
  162. Public Function Create(FN As String, DDraw As CDXVBScreen) As Boolean
  163.       Set m_lpDDS = LoadBitmap(DDraw.m_lpdd, FN)
  164.  
  165.       Create = True
  166. End Function
  167.  
  168. Private Sub Class_Terminate()
  169.       Set m_lpDDS = Nothing
  170. End Sub
  171.  
  172. Public Sub Blit(x As Long, y As Long, Back As IDirectDrawSurface2)
  173.       Back.BltFast x, y, m_lpDDS, m_SrcRect, DDBLTFAST_SRCCOLORKEY
  174. End Sub
  175.  
  176. Public Sub SurfGetDC()
  177.       m_lpDDS.GetDC m_HDC
  178. End Sub
  179.  
  180. Public Sub SurfReleaseDC()
  181.       m_lpDDS.ReleaseDC m_HDC
  182. End Sub
  183.  
  184. Public Sub TextXY(x As Integer, y As Integer, Color As Long, Text As String)
  185.       SetBkMode m_HDC, TRANSPARENT
  186.       SetTextColor m_HDC, Color
  187.       TextOut m_HDC, x, y, Text, Len(Text)
  188. End Sub
  189.  
  190. Public Sub SetSrc(t As Long, l As Long, b As Long, r As Long)
  191.       With m_SrcRect
  192.             .top = t
  193.             .left = l
  194.             .bottom = b
  195.             .right = r
  196.       End With
  197. End Sub
  198.  
  199. Public Sub SetDest(t As Long, l As Long, b As Long, r As Long)
  200.       With m_DstRect
  201.             .top = t
  202.             .left = l
  203.             .bottom = b
  204.             .right = r
  205.       End With
  206. End Sub
  207.  
  208. Public Sub PrivateBlit(x As Integer, y As Integer, Back As IDirectDrawSurface2, Flags As Long)
  209.       m_lpDDS.BltFast x, y, Back, m_SrcRect, DDBLTFAST_WAIT
  210. End Sub
  211.  
  212. Public Sub LockMe()
  213.       CopyMemory m_ddsd, ByVal 0&, Len(m_ddsd)
  214.       m_ddsd.dwSize = Len(m_ddsd)
  215.  
  216.       m_lpDDS.Lock ByVal 0&, m_ddsd, DDLOCK_WAIT Or DDLOCK_SURFACEMEMORYPTR, 0
  217.  
  218.       With sa
  219.             .cbElements = 1
  220.             .cDims = 2
  221.             .Bounds(0).lLbound = 0
  222.             .Bounds(0).cElements = m_ddsd.dwHeight
  223.             .Bounds(1).lLbound = 0
  224.             .Bounds(1).cElements = m_ddsd.dwWidth
  225.             .pvData = m_ddsd.lpSurface
  226.       End With
  227.       CopyMemory ByVal VarPtrArray(video_buffer), VarPtr(sa), 4
  228. End Sub
  229.  
  230. Public Sub Pixel(x As Integer, y As Integer, Color As Integer)
  231.       video_buffer(x, y) = Color
  232. End Sub
  233.  
  234. Public Sub UnLockMe()
  235.       m_lpDDS.Unlock m_ddsd.lpSurface
  236.  
  237.       CopyMemory ByVal VarPtrArray(video_buffer), ByVal 0&, 4
  238. End Sub
  239.